Option Strict Off
Option Explicit On
Module PapagayoTranslator
	'This module translates a Papagayo .pgo file into an exposure sheet that is compatible with Helium Frog. It saves it in the same source directory but with a .txt file extension.
	'This module also requires a list box on a form ,called Utilities2.List1. This outputs the information to the user.
	
	
	Dim PapagayoFile As String
	Dim OutputDataString As String
	Dim InputDataString As String
	Dim NoVoices As Integer
	Dim NoFrames As Integer
	Dim ExpectedFrameRate As Integer
	Dim InputByte As Byte
	Dim XData() As String
	Dim WordString As String
	Dim StartLine As Integer
	Dim Endline As Integer
	Dim NumPhone As String
	Dim LoopCnt As Integer
	Dim PhonemeText As String
	
	Public Function ConvertPapagayo(ByRef SourceFile As Object) As Boolean
		ConvertPapagayo = False 'Set function to initially return false
		Dim X As Integer
		Dim X1 As Integer 'A loop counter
		Dim LineCounter As Integer 'counts the number of lines
		Dim stringlength As Integer
		Dim NewString As String
		Dim PapagayoFile As String
		Dim TextLength As Integer
		
		'UPGRADE_WARNING: Dir has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
		If Dir(PapagayoFile & "1.txt") <> "" Then Kill((PapagayoFile & "1.txt")) 'Delete the text file if it exists
		
		'***************************Remove the first 12 lines of text************************
		TextLength = Len(SourceFile)
		'UPGRADE_WARNING: Couldn't resolve default property of object SourceFile. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
		PapagayoFile = Mid(SourceFile, 1, TextLength - 4)
		FileOpen(1, PapagayoFile & ".pgo", OpenMode.Binary, OpenAccess.Read)
		' Open PapagayoFile & ".pgo" For Binary Access Read As #1
		FileOpen(2, PapagayoFile & "1.txt", OpenMode.Output)
		
		Do Until (EOF(1) = True)
			'UPGRADE_WARNING: Get was upgraded to FileGet and has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
			FileGet(1, InputByte)
			If InputByte = 9 Then GoTo MissOutTabs : 'ignore any tabs
			If InputByte <> 10 Then 'If the character is not a carriage return (actually a line feed character in this file)
				OutputDataString = OutputDataString & Chr(InputByte) 'add character to the output string
			Else
				LineCounter = LineCounter + 1 'Increase the line count
				OutputDataString = "" 'Clear the string ready for the next line
				If LineCounter = 12 Then GoTo RemovedFirstLines
			End If
			
MissOutTabs: 
		Loop 
RemovedFirstLines: 
		
		'***************************Copy it to the new file removing all the tabs************************
		Do Until (EOF(1) = True)
			'UPGRADE_WARNING: Get was upgraded to FileGet and has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
			FileGet(1, InputByte)
			If InputByte = 9 Then GoTo MissOutTabs1 : 'ignore any tabs
			If InputByte <> 10 Then 'If the character is not a carriage return (actually a line feed character in this file)
				OutputDataString = OutputDataString & Chr(InputByte) 'add character to the output string
			Else
				PrintLine(2, OutputDataString) 'write the line out to the file
				OutputDataString = "" 'Clear the string ready for the next line
			End If
			
MissOutTabs1: 
		Loop 
		FileClose(2)
		FileClose(1)
		
		
		'***************************Decode the lines************************
		Dim ExposureText As String
		FileOpen(31, PapagayoFile & "1.txt", OpenMode.Input)
		FileOpen(32, PapagayoFile & "2.txt", OpenMode.Output)
		Do Until (EOF(31) = True)
			'First import the line that contains the Word to say and the start,end and number of phonemes eg a line such as "Hello 102 108 5"
			ExposureText = LineInput(31) 'Inputs a complete line from the phoneme file regardless of commas.
			GetWordStartlineNumPhonemes((ExposureText)) 'Extract info about the line containing the text eg "Seven 102 108 5"
			'We now have Wordstring,StartLine,EndLine,NumPhone variables set
			For LoopCnt = 1 To CInt(NumPhone) 'Go through each of the phonemes (in the above example there are five
				ExposureText = LineInput(31) 'Inputs a complete line from the phoneme file regardless of commas.
				ExposureText = ExposureText & "]" 'Add a square bracket to the end, so a line eg. "103 FV" goes to "103 FV]"
				stringlength = Len(ExposureText) 'Get the length of the string
				NewString = "" 'Clear the string to store the new string to be constructed
				For X1 = 1 To stringlength 'Loop through all the characters in the string
					If Mid(ExposureText, X1, 1) <> " " Then 'Check if the character is not a space
						NewString = NewString & Mid(ExposureText, X1, 1) 'if its not a space, just copy it to the end of the new string
					Else
						NewString = NewString & "[" 'If the character is a space replace it with a square bracket eg. "103 FV]" goes to "103[FV]"
					End If
				Next X1
				If LoopCnt = 1 Then
					PrintLine(32, NewString & WordString) 'If its the first phoneme line place the word text after it
				Else
					PrintLine(32, NewString) 'Otherwise just print it as is to the new file
				End If
			Next LoopCnt
			PrintLine(32, Endline + 1 & "[rest]")
		Loop 
		FileClose(32)
		FileClose(31)
		
		'****************************Now fill string array with data
		
		'UPGRADE_WARNING: Dir has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
		If Dir(PapagayoFile & "2.txt") <> "" Then 'Check if phoneme file exists
			ReDim XData(0)
			FileOpen(23, PapagayoFile & "2.txt", OpenMode.Input)
			Do Until (EOF(23) = True)
				ExposureText = LineInput(23)
				ExtractLineNumAndPhoneme((ExposureText)) 'Gets the line number, phoneme and wordstring if present
				If StartLine - 1 > UBound(XData) Then
					ReDim Preserve XData(StartLine - 1)
				End If
				XData(StartLine - 1) = PhonemeText & " " & WordString
			Loop 
			FileClose(23)
		End If
		
		'***************************Now go through array and make sure there are no "rest" blank spaces inside words
		Dim LastPhoneme As String
		LastPhoneme = ""
		For X1 = 0 To UBound(XData)
			ExtractPhonemeOnly(XData(X1))
			'we now have wordstring set to either "" or the phoneme name
			If WordString = "" Then
				XData(X1) = LastPhoneme
			Else
				LastPhoneme = WordString
			End If
		Next X1
		
		'***************************Now go through array again and remove any line with a "rest" as this makes the sheet easier to read.
		
		For X1 = 0 To UBound(XData)
			ExtractPhonemeOnly(XData(X1))
			'we now have wordstring set to either "" or the phoneme name
			If WordString = "[rest]" Then
				XData(X1) = ""
			End If
		Next X1
		
		
		
		
		'***************************Now print data from string array to list box
		
		frmUtilities2.List1.Items.Clear()
		For X = 0 To UBound(XData)
			frmUtilities2.List1.Items.Add(XData(X))
		Next X
		
		'***************************Now write out the data from the array to a text file
		FileOpen(222, PapagayoFile & ".txt", OpenMode.Output)
		For X = 0 To UBound(XData)
			PrintLine(222, XData(X))
		Next X
		FileClose(222)
		
		'***************************Now clean up any files
		'UPGRADE_WARNING: Dir has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
		If Dir(PapagayoFile & "1.txt") <> "" Then Kill((PapagayoFile & "1.txt")) 'Delete the text file if it exists
		'UPGRADE_WARNING: Dir has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
		If Dir(PapagayoFile & "2.txt") <> "" Then Kill((PapagayoFile & "2.txt")) 'Delete the text file if it exists
		
		Beep()
		ConvertPapagayo = True
		frmUtilities2.List1.Items.Add("File exported as " & PapagayoFile & ".txt")
	End Function
	
	Private Sub GetWordStartlineNumPhonemes(ByRef LineofText As String) 'Extracts Word string,Startline, Endline, and number of phonemes from a string
		Dim NumOfCharacters As Integer
		Dim LP As Integer
		WordString = ""
		' lstInfo.Clear
		frmUtilities2.List1.Items.Clear()
		
		'Find Word
		NumOfCharacters = Len(LineofText) 'Get how many characters are in the line
		For LP = 1 To NumOfCharacters
			If Asc(Left(LineofText, 1)) = 32 Then
				
				LineofText = Mid(LineofText, 2) 'clip the first character off
				GoTo CompletedWordstring 'We have found a space so exit loop
			Else
				WordString = WordString & (Left(LineofText, 1)) 'Add the character to WordString
				LineofText = Mid(LineofText, 2) 'clip the first character off
			End If
		Next LP
CompletedWordstring: 
		
		'Find startline
		Dim StartLineString As String
		NumOfCharacters = Len(LineofText) 'Get how many characters are in the line
		For LP = 1 To NumOfCharacters
			If Asc(Left(LineofText, 1)) = 32 Then
				
				LineofText = Mid(LineofText, 2) 'clip the first character off
				GoTo CompletedStartline 'We have found a space so exit loop
			Else
				StartLineString = StartLineString & (Left(LineofText, 1)) 'Add the character to WordString
				LineofText = Mid(LineofText, 2) 'clip the first character off
			End If
		Next LP
CompletedStartline: 
		StartLine = Val(StartLineString)
		
		'Find endline
		Dim EndLineString As String
		NumOfCharacters = Len(LineofText) 'Get how many characters are in the line
		For LP = 1 To NumOfCharacters
			If Asc(Left(LineofText, 1)) = 32 Then
				
				LineofText = Mid(LineofText, 2) 'clip the first character off
				GoTo CompletedEndline 'We have found a space so exit loop
			Else
				EndLineString = EndLineString & (Left(LineofText, 1)) 'Add the character to WordString
				LineofText = Mid(LineofText, 2) 'clip the first character off
			End If
		Next LP
CompletedEndline: 
		Endline = Val(EndLineString)
		
		'Find Number of phonemes
		Dim NumPhoneString As String
		NumOfCharacters = Len(LineofText) 'Get how many characters are in the line
		For LP = 1 To NumOfCharacters
			If Asc(Left(LineofText, 1)) = 32 Then
				
				LineofText = Mid(LineofText, 2) 'clip the first character off
				GoTo CompletedNumPhone 'We have found a space so exit loop
			Else
				NumPhoneString = NumPhoneString & (Left(LineofText, 1)) 'Add the character to WordString
				LineofText = Mid(LineofText, 2) 'clip the first character off
			End If
		Next LP
CompletedNumPhone: 
		NumPhone = CStr(Val(NumPhoneString))
		
		'lstInfo.AddItem WordString
		'lstInfo.AddItem StartLineString
		'lstInfo.AddItem Endline
		'lstInfo.AddItem NumPhone
	End Sub
	
	Private Sub ExtractLineNumAndPhoneme(ByRef LineofText As String) 'extracts a line number and a phoneme from a string
		Dim stringlength1 As String
		Dim X2 As Integer
		Dim X3 As Integer
		Dim LineNumText As String
		PhonemeText = ""
		WordString = ""
		
		'Extract the line number
		stringlength1 = CStr(Len(LineofText)) 'Get the length of the string
		For X2 = 1 To CInt(stringlength1)
			If Mid(LineofText, X2, 1) <> "[" Then 'Check if the character is not a "["
				LineNumText = LineNumText & Mid(LineofText, X2, 1)
			Else
				GoTo foundfirstbracket
			End If
		Next X2
foundfirstbracket: 
		StartLine = Val(LineNumText)
		
		'extract the phoneme text
		For X3 = X2 + 1 To CInt(stringlength1)
			If Mid(LineofText, X3, 1) <> "]" Then 'Check if the character is not a "]"
				PhonemeText = PhonemeText & Mid(LineofText, X3, 1)
			Else
				GoTo foundsecondbracket
			End If
		Next X3
foundsecondbracket: 
		PhonemeText = "[" & PhonemeText & "]"
		
		'extract the word to say if it is present on the line
		If X3 = Len(LineofText) Then
			WordString = ""
		Else
			WordString = Mid(LineofText, X3 + 1)
		End If
		
	End Sub
	
	Private Sub ExtractPhonemeOnly(ByRef LineofText As String) 'extracts just the phoneme from the start of a line
		Dim X2 As Integer
		Dim X3 As Integer
		Dim stringlength1 As Integer
		
		WordString = ""
		If LineofText = "" Then Exit Sub
		
		'Extract the phoneme text at the start of a line
		stringlength1 = Len(LineofText) 'Get the length of the string
		For X2 = 1 To stringlength1
			If Mid(LineofText, X2, 1) = "]" Then 'Check if the character is  a "]"
				WordString = WordString & "]" 'Weve found the end, so add the square bracket and exit the subroutine
				Exit Sub
			Else
				WordString = WordString & Mid(LineofText, X2, 1) 'We haven't found the end bracket yet, so just add the to the text
			End If
		Next X2
		
		
	End Sub
End Module